PsL Monthly 1993 December/PSL Monthly Shareware CD-ROM (December 1993).iso/prgmming/dos/pascal/comprog.pas

Pascal/Delphi Source File | 1991-10-01 | 5KB | 199 lines

program GenComProg;
{$X+}
{$R+}
uses
       dos, objects, drivers,
       App, menus, views, dialogs,
       AnsiView,
       COMIo;

Const
   cmBase         = 100;
   cmNotYet       = cmBase;
   cmAbout        = cmBase + 1;
   cmDosShell     = cmBase + 2;
   cmConnect      = cmBase + 3;
   cmSerialIn     = cmBase + 4;

type
      PGenComApp = ^TGenComApp;
      TGenComApp  = object(TApplication)
        constructor Init;
        procedure   GetEvent(var Event: TEvent); virtual;
        procedure   HandleEvent(var E : TEvent); virtual;
        procedure   Idle; virtual;
        procedure   InitStatusLine;  virtual;
        procedure   InitMenuBar;     virtual;
        end;

      PComWindow = ^TComWindow;
      TComWindow = OBJECT(TANSIView)
                     Count : BYTE;
                     constructor Init;
                     procedure HandleEvent(var Event : TEvent); virtual;
                  END;

      Config_Record = record
            PhoneNumber : String[30]; {Inputline}
            ModemString : String[20]; {Inputline}
            ModemBaud : Word;  {Radiobuttons}
            ModemPort : Word;  {Radiobuttons}
            DataSize : Word;  {Radiobuttons}
            ParityOpt : Word;  {Radiobuttons}
            Options : Word; {Checkbox}
            end;

var
      GenComApp: PGenComApp;

const
      DataRec : Config_Record = (
         PhoneNumber : '623-7122';
         ModemString : 'AT&C1&D2';
         ModemBaud : 2;
         ModemPort : 1;
         DataSize  : 0;
         ParityOpt : 1;
         Options   : 2);

constructor TGenComApp.Init;
 var
       BuffSize : word;
       R: TRect;
       L: TPoint;
       S: PStream;
 begin
 if (DataRec.Options and 4) = 4 then
      BuffSize := $4000 else BuffSize := $1000;
 ComInit(BuffSize);
 TApplication.Init;
 end;

procedure TGenComApp.InitMenuBar;
 var R : TRect;
 begin
 GetExtent (R);
 R. B. Y := R. A. Y + 1;
 MenuBar := NEW (PMenuBar,
    Init (R,NewMenu (
            NewItem ('~C~onnect', 'Alt-C', kbAltC, cmConnect, hcNoContext,
            NewItem ('E~x~it', 'Alt-X', kbAltX, cmQuit, hcNoContext,
            nil)))));
 end;

procedure TGenComApp.InitStatusLine;
 var R : TRect;
 begin
 GetExtent (R);
 R. A. Y := R. B. Y - 1;
 StatusLine := NEW (PStatusLine,Init (R,NewStatusDef (0, $FFFF,
                    NewStatusKey ('~Alt-X~ Exit', kbAltX, cmQuit,
                    NewStatusKey ('~Alt-F3~ Close', kbAltF3, cmClose,
                    NewStatusKey ('~F10~ Menu', kbF10, cmMenu,
                    NewStatusKey ('', kbCtrlF5, cmResize,
                    nil)))), nil)));
 end;

procedure TGenComApp.GetEvent(var Event: TEvent);
 begin
 TApplication.GetEvent(Event);
 end;

procedure TGenComApp.HandleEvent(var E : TEvent);
 procedure NewComWindow;
  var
        PPtr : PComWindow;
  begin
  PPtr := NEW(PComWindow,Init);
  if PPtr <> NIL THEN DeskTop^.Insert(PPtr);
  end;

 begin
 TApplication.HandleEvent(E);
 if E.What = evCommand then begin
     case E.Command of
         cmConnect   : NewComWindow;
         else
            exit;
         end;
     ClearEvent(E);
     end;
 end;

procedure TGenComApp.Idle;
 var
     Fluckers : byte;
     Fake     : pointer absolute Fluckers;
 begin
 if ComIsOpen then
    if ComAvail then begin
       Fluckers := ComGet;
       Message(TopView,evCommand,cmSerialIn,Fake);
       end;

 TApplication.Idle;
 end;

constructor TComWindow.Init;
 const
  BaudArr: array[0..4] of Byte = (Baud300, Baud1200, Baud2400, Baud4800, Baud9600);
  DataBitsArr: array[0..1] of Byte = (WordSize7, WordSize8);
  ParityArr: array[0..2] of Byte = (NoParity, EvenParity, OddParity);
 var
      R : TRect;
      L : TPoint;
      X : BYTE;
      Y : BYTE;
 begin
 R.Assign(1,2,73,12);
 L.X := 80;
 L.Y := 50;
 TANSIView.Init(R,L,'Communications Window',0);
 Options := Options or ofCentered;
 with DataRec do
    ComSetParam(ModemPort,
                BaudArr[ModemBaud] or
                DataBitsArr[DataSize] or
                ParityArr[ParityOpt] or
                StopBits1);
 Count := 0;
 GotoXY(1,1);
 end;

PROCEDURE TComWindow.HandleEvent;
 VAR   i : INTEGER;
 BEGIN
 TANSIView.HandleEvent(Event);
 CASE Event.What OF
      evKeyDown : begin
                  if Event.CharCode <> #0 then
                      if Event.CharCode = #13 then ComPut(13)
                      else ComPut(Byte(Event.CharCode))
                  else exit;
                  end;
      evCommand : if Event.Command = cmSerialIn then
                    printchar(char(Event.InfoPtr))
                    else exit;
      ELSE EXIT
 END;
 ClearEvent(Event)
 END;

begin
with DataRec do begin
   PhoneNumber := '623-7122';
   ModemString := 'AT&C1&D2';
   ModemPort := 1;
   ModemBaud := 2;
   DataSize  := 0;
   ParityOpt := 1;
   Options   := 2;
   end;

GenComApp := New(PGenComApp,Init);
GenComApp^.Run;
Dispose(GenComApp,Done);
ComDone;

end.